home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / comm / mail / octetpurge.lha / OctetPurge / OctetPurge.bas < prev    next >
BASIC Source File  |  1998-02-05  |  4KB  |  171 lines
  1. REM Octet Purger 1.1 by Simon N Goodwin, December 1997.
  2. REM Updated February 1998 to fix the 'NOT Copying' bug
  3. REM
  4. REM WHAT?
  5. REM
  6. REM Program to scan MIME a mail file and remove all
  7. REM octet-stream binary encoded data sections.
  8. REM
  9. REM REQUIREMENTS
  10. REM
  11. REM Written in HiSoft BASIC. Requires ASL library.
  12. REM Uses 15 point Helvetica.font if it's available.
  13. REM
  14. REM WHY?
  15. REM
  16. REM Written to keep the size of archived YAM mail
  17. REM manageable, on the basis that binary contents
  18. REM ought to be archived somewhere else already.
  19. REM
  20. REM HOW?
  21. REM 
  22. REM Start from Workbench by clicking on the icon.
  23. REM Select a file to be scanned or CANCEL to quit.
  24. REM Repeat selection for each file to be purged.
  25. REM
  26. REM Input file is not modified. A new file on the
  27. REM same path with the suffix ".purged" is created
  28. REM containing the original contents except with
  29. REM the 'application octet-stream' data sections
  30. REM replaced with the text:
  31. REM
  32. REM     **** Octet stream deleted from archive.
  33. REM
  34. REM KNOWN BUGS
  35. REM
  36. REM No check that the output file name is valid.
  37. REM No diagnostics if the input file is malformed.
  38. REM
  39. REM In HiSoft BASIC, NOT 1 = TRUE! This stopped
  40. REM the first release copying the first part of
  41. REM the file. This has been fixed in version 1.1.
  42. REM
  43. REM
  44. REM STATUS
  45. REM
  46. REM Freely distributable; you must include source.
  47. REM
  48. REM AUTHOR
  49. REM
  50. REM Simon N Goodwin, simon@studio.woden.com
  51. REM
  52.  
  53. DEFINT a-z
  54.  
  55. ' HiSoft ASL library and disk font initialisation
  56.  
  57. REM $INCLUDE diskfont.bh
  58. REM $INCLUDE graphics.bh
  59. REM $include asl.bh
  60. LIBRARY OPEN "asl.library"
  61. LIBRARY OPEN "diskfont.library"
  62. LIBRARY OPEN "graphics.library"
  63.  
  64. WINDOW 1,"  MIME Mail archive file Octet Purger v1.1  ", _
  65.     (32,16)-(608,160),1+2+4+16+256
  66.  
  67. REM Use a groovier Compugraphic fo(u)nt if you wish
  68.  
  69. DIM TextAttr(4)
  70. InitTextAttr TextAttr(),"Helvetica.font",15,0,0
  71. font& = OpenDiskFont (VARPTR(TextAttr(0)))
  72.  
  73. IF font&
  74.   SetFont WINDOW (8), font&
  75. ELSE
  76.   PRINT " **** Preferred font not available. Using default."
  77. END IF
  78.  
  79. pattern$="Content-Type: application/octet-stream"
  80. patlen=LEN(pattern$)
  81.  
  82. boundary$="--BOUNDARY"
  83. boundlen=LEN(boundary$)
  84.  
  85. ' ASL requester initialisation
  86.  
  87. CONST TAG_DONE&=0,TRUE&=1,ABORT&=-1,FALSE&=0
  88. DIM frtags&(20)
  89.  
  90. ' Main program
  91.  
  92. ok=TRUE
  93.  
  94. REPEAT main
  95.     
  96.     TAGLIST VARPTR(frtags&(0)),ASLFR_TitleText&, _
  97.         "Select the file to be purged", _
  98.         ASLFR_InitialFile&,"", _
  99.         ASLFR_InitialDrawer&,"RAM:", _
  100.         ASLFR_InitialHeight&,     130, _
  101.         ASLFR_InitialLeftEdge&, 280, _
  102.         ASLFR_InitialWidth&,         310, _ 
  103.         TAG_DONE&
  104.         
  105.     fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frtags&(0)))
  106.     IF fr& THEN
  107.         ok&=AslRequest&(fr&,0)
  108.         IF ok& THEN
  109.             file$=PEEK$(PEEKL(fr&+fr_File))
  110.             dir$=PEEK$(PEEKL(fr&+fr_Drawer))
  111.             IF LEN(dir$)
  112.                 suffix$=RIGHT$(dir$,1)
  113.                 IF suffix$<>"/" AND suffix$<>":" THEN dir$=dir$+"/"
  114.             END IF
  115.         END IF
  116.         FreeASlRequest fr&
  117.     ELSE
  118.         ok&=ABORT&
  119.     END IF
  120.  
  121.   IF ok&=FALSE& OR ok&=ABORT& THEN EXIT main
  122.  
  123.   file$=dir$+file$
  124.   
  125.     PRINT
  126.  
  127.     OPEN file$ FOR INPUT AS #3
  128.     OPEN file$+".purged" FOR OUTPUT AS #4
  129.  
  130.     copying=1 : found=0
  131.  
  132.     REPEAT scan
  133.       IF EOF(3) THEN EXIT scan
  134.       INPUT #3,a$
  135.       IF copying=0
  136.         copying=LEFT$(a$,boundlen)=boundary$
  137.       END IF
  138.       IF LEFT$(a$,patlen)=pattern$
  139.         PRINT #4,a$
  140.         PRINT " Purging: ";a$
  141.         PRINT #4
  142.         PRINT #4,"**** Octet stream deleted from archive."
  143.         PRINT #4
  144.         copying=0: found=found+1
  145.       END IF
  146.       IF copying THEN PRINT #4,a$ :REM debug PRINT a$
  147.     END REPEAT scan 
  148.  
  149.     CLOSE #4
  150.     CLOSE #3
  151.  
  152.     PRINT
  153.     PRINT " OK,";found;"octet stream";
  154.     IF found<>1 THEN PRINT "s";
  155.     PRINT " found in ";file$
  156.     PRINT
  157.     PRINT " Condensed version written to ";file$+".purged"
  158.     
  159. END REPEAT main
  160.  
  161. SYSTEM
  162.  
  163. SUB InitTextAttr(T(1),FontName$,BYVAL Height,BYVAL style,BYVAL flags)
  164.  
  165. POKEL VARPTR(T(0))+ta_Name,SADD(FontName$+CHR$(0))
  166. t(ta_YSize\2)=Height
  167. POKEB VARPTR(T(0))+ta_Style,style
  168. POKEB VARPTR(T(0))+ta_Flags,flags
  169.  
  170. END SUB ' InitTextAttr
  171.